Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/Finger 1.3.5/source/TCP Units/TCPStuff.unit

Text File | 1992-02-24 | 20.9 KB | 718 lines | [TEXT/PJMM]

unit TCPStuff;

{ This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
{ Copyright 1991-1992 Peter N Lewis }
{ If you use this code, you must give me credit in your about box and documentation }
{ This is part of my TCP library of routines }


interface

    uses
        TCPTypes;

    const
        TCPBUFFERSIZE = 4096;    { Amount of space to allocate for each TCP connection }
        INCOMINGBUFSIZE = 100;    { Incoming buffer size, used for buffering ReceiveUpTo. }
        control_block_max = 260;
        tooManyControlBlocks = -23098;

    type
        OSErrPtr = ^OSErr;

{ TCP connection description: }
        TCPConnectionType = record
                magic: OSType;    { A magic number to try and avoid problems with released connection IDs. }
                stream: StreamPtr;
                asends, asendcompletes: longInt;
                closedone: boolean;
                closeuserptr: OSErrPtr;
                incomingPtr: Ptr;                                { Pointer into inBuf of next byte to read. }
                incomingSize: longInt;                        { Number of bytes left in inBuf. }
                buffer: array[1..TCPBUFFERSIZE] of SignedByte;        { connection buffer. }
                inBuf: array[1..INCOMINGBUFSIZE] of SignedByte;    {Input buffer. }
            end;
        TCPConnectionPtr = ^TCPConnectionType;

        MyControlBlock = record
                tcp: TCPControlBlock;
                inuse: boolean;
                userptr: OSErrPtr;
                proc: procPtr;
                tcpc: TCPConnectionPtr;
            end;
        MyControlBlockPtr = ^MyControlBlock;


        TCPStateType = (T_WaitingForOpen, T_Closed, T_Listening, T_Opening, T_Established,{}
            T_Closing, T_PleaseClose, T_Unknown);

    function TCPNameToAddr (var hostName: str255; timeout: longInt; var hostFile: str255): longInt;
    function TCPOpenResolver (var hostFile: str255; var dataptr: ptr): OSErr;
    function TCPStrToAddr (dataptr: ptr; var hostName: str255; var rtnStruct: hostInfo; var done: signedByte): OSErr;
    procedure TCPAddrToStr (dataptr: ptr; addr: longInt; var addrStr: str255);
    function TCPAddrToName (dataptr: ptr; addr: longInt; var rtnStruct: hostInfo; var done: signedByte): OSErr;
    procedure TCPCloseResolver (dataptr: ptr);

    function C2PStr (s: stringPtr): stringPtr;
    procedure SanitizeHostName (var s: str255);

    function TCPInit: OSErr;
    procedure TCPFinish;
    function TCPGetMyIPAddr (var myIP: longInt): OSErr;
    function TCPActiveOpen (var connection: TCPConnectionPtr; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
    function TCPPassiveOpen (var connection: TCPConnectionPtr; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
    function TCPFlush (connection: TCPConnectionptr): OSErr;
    function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
    function TCPAbort (connection: TCPConnectionPtr): OSErr;
    function TCPRelease (var connection: TCPConnectionPtr): OSErr;
    procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longInt; var localport: integer; var remotehost: longInt; var remoteport: integer; var available: longInt);
    function TCPState (connection: TCPConnectionPtr): TCPStateType;
    function TCPCharsAvailable (connection: TCPConnectionPtr): longInt;
    function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
{ Use EITHER RawReceive, or the other Receives.  Don't combine them for one stream! }
    function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
    function TCPReadByte (connection: TCPConnectionPtr; timeout: longInt; var b: SignedByte): OSErr;
    function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
                                    charTimeOut: longInt; readPtr: ptr; readSize: longInt; var readPos: longInt;{}
                                    var gottermchar: boolean): OSErr;
    function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer): OSErr;
    function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; userptr: OSErrPtr): OSErr;

implementation

{    Loosely based on code by Harry Chesley 12/88, thus Copyright © 1988 Apple Computer, Inc.}
{    Converted to sensible pascal interface 7/91 by Peter Lewis, thus also Copyright © 1991 Peter Lewis }

    const
        MAGICNUMBER = 'TMGK';    { Unique value used to trap illegal connection IDs. }
        dispose_block_max = 100;

    type
        MyControlBlockArray = array[1..control_block_max] of MyControlBlockPtr;

    var
        driver_refnum: integer;
        controlblocks: MyControlBlockArray;
        max_dispose_block: integer;
        disposeblocks: array[1..dispose_block_max] of ptr;

    procedure SanitizeHostName (var s: str255);
        var
            dummysp: stringPtr;
    begin
        dummysp := C2PStr(@s);
{$PUSH}
{$R-}
        if s[Length(s)] = '.' then
            s[0] := chr(Length(s) - 1);
{$POP}
    end;

    function GetA6: ptr;
    inline
        $2F4E, $0000;

    procedure CallCompletion (cbp: MyControlBlockPtr; addr: procPtr);
    inline
        $205F, $4E90;

{$PUSH}
{$D-}
    procedure IOCompletion; { All C functions look like pascal paramterless procedures from the procs point of view }
        type
            stackframe = packed record
                    frameptr: ptr;
                    returnptr: ptr;
                    paramblockptr: MyControlBlockPtr;
                end;
            stackframeptr = ^stackframe;
        var
            a6: stackframeptr;
            cbp: MyControlBlockPtr;
    begin
        a6 := stackframeptr(GetA6);
        cbp := a6^.paramblockptr;
        with cbp^ do begin
            if userptr <> nil then
                userptr^ := cbp^.tcp.ioResult;
            inuse := false;
            if proc <> nil then
                CallCompletion(cbp, proc);
        end;
    end;
{$POP}

    procedure ZotBlocks;
    begin
        while max_dispose_block > 0 do begin
            DisposPtr(disposeblocks[max_dispose_block]);
            max_dispose_block := max_dispose_block - 1;
        end;
    end;

    procedure AddBlock (p: univ ptr);
    begin
        if max_dispose_block < dispose_block_max then begin
            max_dispose_block := max_dispose_block + 1;
            disposeblocks[max_dispose_block] := p;
        end;
    end;

    procedure ZeroCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
    { Zero out the control block parameters. }
        var
            i: integer;
            p: longInt;
    begin
        ZotBlocks;
        for p := longInt(@cb) to longInt(@cb) + SizeOf(TCPControlBlock) - 1 do
            ptr(p)^ := 0;
        cb.tcpStream := stream;
        cb.ioCRefNum := driver_refnum;
        cb.csCode := call;
    end;

    function GetCB (var cbp: MyControlBlockPtr; tcpc: TCPConnectionPtr; call: integer; userptr: OSErrPtr; proc: procptr): OSErr;
{ NOTE: Must not move memory if there is a free block available (ie, during a Completion call) }
        var
            i: integer;
    begin
        i := 1;
        while (i < control_block_max) & (controlblocks[i] <> nil) & controlblocks[i]^.inuse do
            i := i + 1;
        cbp := controlblocks[i];
        if cbp = nil then begin
            cbp := MyControlBlockPtr(NewPtr(SizeOf(MyControlBlock)));
            if cbp <> nil then begin
                cbp^.inuse := false;
                controlblocks[i] := cbp;
            end;
        end;
        if (cbp <> nil) & not cbp^.inuse then begin
            ZeroCB(cbp^.tcp, tcpc^.stream, call);
            cbp^.tcp.ioCompletion := @IOCompletion;
            cbp^.inuse := true;
            cbp^.userptr := userptr;
            cbp^.tcpc := tcpc;
            cbp^.proc := proc;
            if userptr <> nil then
                userptr^ := inprogress;
            GetCB := noErr;
        end
        else begin
            cbp := nil;
            GetCB := outOfMemory;
        end;
    end;

    procedure FreeCB (var cbp: MyControlBlockPtr);
    begin
        if cbp <> nil then
            cbp^.inuse := false;
        cbp := nil;
    end;

{$S Init}
    function TCPInit: OSErr;
        var
            oe: OSErr;
            i: integer;
    begin
        max_dispose_block := 0;
        oe := OpenDriver('.IPP', driver_refnum);
        for i := 1 to control_block_max do
            controlblocks[i] := nil;
        TCPInit := oe;
    end;

{$S Term}
    procedure TCPFinish;
        var
            i: integer;
    begin
        for i := 1 to control_block_max do
            if controlblocks[i] <> nil then begin
                DisposPtr(ptr(controlblocks[i]));
                controlblocks[i] := nil;
            end;
    end;

{$S}
    procedure DestroyConnection (var connection: TCPConnectionPtr);
    begin
        connection^.magic := '????';
        DisposPtr(Ptr(connection));
        connection := nil;
    end;

    function ValidateConnection (connection: TCPConnectionPtr): OSErr;
    begin
        if connection = nil then
            ValidateConnection := connectionDoesntExist
        else if connection^.magic <> MAGICNUMBER then
            ValidateConnection := connectionDoesntExist
        else
            ValidateConnection := noErr;
    end;

    function PBControlSync (var cb: TCPControlBlock): OSErr;
    begin
        PBControlSync := PBControl(@cb, false);
    end;

    function PBControlAsync (var cbp: MyControlBlockPtr): OSErr;
        var
            oe: OSErr;
    begin
        oe := PBControl(ParmBlkPtr(cbp), true);
        if oe <> noErr then
            FreeCB(cbp);
        PBControlAsync := oe;
    end;

    function TCPGetMyIPAddr (var myIP: longInt): OSErr;
        var
            cb: TCPControlBlock;
            oe: OSErr;
    begin
        ZeroCB(cb, nil, TCPcsGetMyIP);
        oe := PBControlSync(cb);
        myIP := cb.getmyip.ourAddress;
        TCPGetMyIPAddr := oe;
    end;

    procedure SetUserPtr (userptr: OSErrPtr; oe: OSErr);
    begin
        if userptr <> nil then begin
            if oe <> noErr then
                userptr^ := oe;
        end;
    end;

    function CreateStream (var connection: TCPConnectionPtr): OSErr;
        var
            oe: OSErr;
            cb: TCPControlBlock;
    begin
        connection := TCPConnectionPtr(NewPtr(sizeof(TCPConnectionType)));
        if connection = nil then
            oe := outOfMemory
        else
            with connection^ do begin
                magic := MAGICNUMBER;
                asends := 0;
                asendcompletes := 0;
                closedone := false;
                incomingSize := 0;
                ZeroCB(cb, nil, TCPcsCreate);
                cb.create.rcvBuff := @connection^.buffer;
                cb.create.rcvBuffLen := TCPBUFFERSIZE;
                oe := PBControlSync(cb);
                stream := cb.tcpStream;
            end;
        if (oe <> noErr) and (connection <> nil) then
            DestroyConnection(connection);
        CreateStream := oe;
    end;

    function PAOpen (var connection: TCPConnectionPtr; cs: integer; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
        var
            oe, ooe: OSErr;
            cbp: MyControlBlockPtr;
            cb: TCPControlBlock;
    begin
        oe := CreateStream(connection);
        if oe = noErr then begin
            with connection^ do begin
                oe := GetCB(cbp, connection, cs, userptr, nil);
                if oe = noErr then begin
                    cbp^.tcp.open.localPort := localPort;
                    cbp^.tcp.open.remoteHost := remoteIP;
                    cbp^.tcp.open.remotePort := remoteport;
                    oe := PBControlAsync(cbp);
                end;
                if oe <> noErr then begin
                    ZeroCB(cb, stream, TCPcsRelease);
                    ooe := PBControlSync(cb);
                    DestroyConnection(connection);
                end;
            end;
        end;
        SetUserPtr(userptr, oe);
        PAOpen := oe;
    end;

{ Open a connection to another machine }
    function TCPActiveOpen (var connection: TCPConnectionPtr; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
    begin
        TCPActiveOpen := PAOpen(connection, TCPcsActiveOpen, localport, remoteIP, remoteport, userptr);
    end;

{ Open a socket on this machine, to wait for a connection }
    function TCPPassiveOpen (var connection: TCPConnectionPtr; localport: integer; remoteIP: longInt; remoteport: integer; userptr: OSErrPtr): OSErr;
    begin
        TCPPassiveOpen := PAOpen(connection, TCPcsPassiveOpen, localport, remoteIP, remoteport, userptr);
    end;

    function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
{ Return readCount characters from the TCP connection. }
{ WARNING: Doesnt handle incoming buffer, so don't use with TCPReceiveUptp or ReadByte }
        var
            cb: TCPControlBlock;
    begin
        ZeroCB(cb, connection^.stream, TCPcsRcv);
        cb.receive.rcvBuff := returnPtr;
        cb.receive.rcvBuffLength := readCount;
        TCPRawReceiveChars := PBControlSync(cb);
    end;

{ Return readCount characters from the TCP connection.}
    function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
        var
            readCountStr: Str255;
            l: longInt;
            p: Ptr;
            oe: OSErr;
            cb: TCPControlBlock;
    begin
        oe := ValidateConnection(connection);
        if oe = noErr then
            if readCount < 0 then
                oe := invalidLength
            else if readCount > 0 then begin
                p := returnPtr;
                with connection^ do
                    if incomingSize > 0 then begin
            { Read as much as there is or as much as we need, whichever is less. }
                        if readCount < incomingSize then
                            l := readCount
                        else
                            l := incomingSize;
                        BlockMove(incomingPtr, p, l);
                        incomingPtr := Ptr(ord4(incomingPtr) + l);
                        incomingSize := incomingSize - l;
                        p := Ptr(ord4(p) + l);
                        readCount := readCount - l;
                    end;
                { If there's more needed, then read it from the connection. }
                if readCount > 0 then begin
                        { Issue a read and wait until it all arrives). }
                    oe := TCPRawReceiveChars(connection, p, readCount);
                end;
            end;
        TCPReceiveChars := oe;
    end;

    function TCPReadByte (connection: TCPConnectionPtr; timeout: longInt; var b: SignedByte): OSErr;
        { Return the next byte in the buffer, reading more in if necessary. }
        var
            waitUntil: longInt;
            readIn: longInt;
            oe: OSErr;
            cb: TCPControlBlock;
    begin
        oe := ValidateConnection(connection);
        if oe = noErr then
            with connection^ do begin            { Check if we need to read in more bytes. }
                if incomingSize = 0 then begin
                    if timeout = 0 then
                        oe := commandTimeout
                    else begin
                        waitUntil := TickCount + timeout;
    { keep on trying to read until we get at least one, or the time-out happens. }
                        while (oe = noErr) and (incomingSize = 0) do begin                { Get the status. }
                            readIn := TCPCharsAvailable(connection);    { If there's something there to read, do so. }
                            if readIn > 0 then begin    { Don't read any more than will fit in the buffer. }
                                if readIn > INCOMINGBUFSIZE then
                                    readIn := INCOMINGBUFSIZE;
                        { Issue the read. }
                                oe := TCPRawReceiveChars(connection, @inBuf, readIn);
                                if oe = noErr then begin
                                    incomingSize := readIn;
                                    incomingPtr := @inBuf;
                                end;
                            end        { If not, do another round or get out, depending on the timeout condition. }
                            else if TickCount > waitUntil then begin
                                oe := commandTimeOut;
                            end;
                        end;
                    end;
                end;
                { Get the byte to return. }
                if incomingSize > 0 then begin
                    b := incomingPtr^;
                    incomingPtr := Ptr(ord4(incomingPtr) + 1);
                    incomingSize := incomingSize - 1;
                end
                else
                    b := 0;
            end;
        TCPReadByte := oe;
    end;

{ Pass in a block of memory (readPtr,readSize), already containing readPos bytes}
{ TCPReceiveUpTo will then read characters until a termChar character is reached,}
{ or until waitForChars ticks go by without receiving any bytes.  If waitForChars is}
{ zero, then TCPReceiveUpTo will return immediately.  If termChar=0, then it}
{ will read the entire buffer, and any characters that arrive before a timeout }
    function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
                                    charTimeOut: longInt; readPtr: ptr; readSize: longInt; var readPos: longInt;{}
                                    var gottermchar: boolean): OSErr;
        var
            oe: OSErr;

        procedure putByte (b: signedByte);
        { Put the byte b after the output handle, increasing the handle's size in the process. }
            var
                p: Ptr;
        begin
            p := Ptr(ord4(readPtr) + readPos);
            p^ := b;
            readPos := readPos + 1;
        end;

        var
            inChar: SignedByte;

    begin
        oe := ValidateConnection(connection);
        gottermchar := false;
{ Cycle until the timeout happens or we see the termintor character or we run out of room. }
        while (oe = noErr) and (readPos < readSize) and not gottermchar do begin            { Get the next character. }
            oe := TCPReadByte(connection, charTimeOut, inChar);                    { Ignore the character if it's a zero. }
            if (oe = noErr) and (inChar <> 0) then begin            { Put it in the result. }
                putByte(inChar);                    { Check for the end. }
                gottermchar := inChar = termChar;
            end;
        end;
        if oe = commandTimeOut then
            oe := noErr;
        TCPReceiveUpTo := oe;
    end;

    function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer): OSErr;
        var
            wds: wdsType;
            oe: OSErr;
            cb: TCPControlBlock;
            p: ptr;
    begin
        oe := ValidateConnection(connection);
        if oe = nOErr then
            if writeCount > 0 then begin
                wds.buffer := writePtr;
                wds.size := writeCount;
                wds.term := 0;
                ZeroCB(cb, connection^.stream, TCPcsSend);
                cb.send.wds := @wds;
                oe := PBControlSync(cb);
            end
            else if writeCount < 0 then
                oe := InvalidLength;
        TCPSend := oe;
    end;

    procedure TCPSendComplete (cbp: MyControlBlockPtr);
        var
            oe: OSErr;
    begin
        AddBlock(cbp^.tcp.send.wds);
        with cbp^.tcpc^ do begin
            asendcompletes := asendcompletes + 1;
            if (asendcompletes = asends) and closedone then begin
                asendcompletes := asendcompletes - 1; { Avoid race condition with TCPClose }
                oe := GetCB(cbp, cbp^.tcpc, TCPcsClose, closeuserptr, nil);
{ GetCB won't NewPtr because the completion has just released a block }
                if oe = noErr then
                    oe := PBControlAsync(cbp);
            end;
        end;
    end;

    function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; userptr: OSErrPtr): OSErr;
        type
            myblock = record
                    wds: wdsType;
                    data: array[0..100] of byte;
                end;
            myblockptr = ^myblock;
        var
            oe: OSErr;
            cbp: MyControlBlockPtr;
            p: myblockptr;
    begin
        oe := ValidateConnection(connection);
        if oe = nOErr then
            if writeCount > 0 then begin
                p := myblockptr(NewPtr(writeCount + SizeOf(wdsType)));
                if p = nil then
                    oe := outOfMemory
                else begin
                    p^.wds.buffer := @p^.data;
                    p^.wds.size := writeCount;
                    p^.wds.term := 0;
                    with p^.wds do
                        BlockMove(writePtr, buffer, size);
                    oe := GetCB(cbp, connection, TCPcsSend, userptr, @TCPSendComplete);
                    cbp^.tcp.send.wds := POINTER(p);
                    with connection^ do
                        asends := asends + 1;
                    oe := PBControlAsync(cbp);
                    if oe <> noErr then
                        DisposPtr(ptr(p));
                end;
            end
            else if writeCount < 0 then
                oe := InvalidLength;
        TCPSendAsync := oe;
    end;

    function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
        var
            oe: OSErr;
            cbp: MyControlBlockPtr;
    begin
        oe := ValidateConnection(connection);
        if oe = noErr then
            with connection^ do begin
                closeuserptr := userptr;
                if userptr <> nil then
                    userptr^ := inProgress;
                closedone := true;
                if asends = asendcompletes then begin
                    oe := GetCB(cbp, connection, TCPcsClose, userptr, nil);
                    if oe = noErr then begin
                        oe := PBControlAsync(cbp);
                    end;
                end;
            end;
        SetUserPtr(userptr, oe);
        TCPClose := oe;
    end;

    function TCPAbort (connection: TCPConnectionPtr): OSErr;
        var
            oe: OSErr;
            cb: TCPControlBlock;
    begin
        oe := ValidateConnection(connection);
        if oe = noErr then begin
            ZeroCB(cb, connection^.stream, TCPcsAbort);
            oe := PBControlSync(cb);
        end;
        TCPAbort := oe;
    end;

{ Release the TCP stream, including the buffer.}
    function TCPRelease (var connection: TCPConnectionPtr): OSErr;
        var
            oe: OSErr;
            cb: TCPControlBlock;
    begin
        oe := ValidateConnection(connection);
        if oe = noErr then begin
            ZeroCB(cb, connection^.stream, TCPcsRelease);
            oe := PBControlSync(cb);
            DestroyConnection(connection);
        end;
        TCPRelease := oe;
    end;

{    TCPRawState(connectionID) -- Return the state of the TCP connection.}
    procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longInt; var localport: integer; var remotehost: longInt; var remoteport: integer; var available: longInt);
        var
            cb: TCPControlBlock;
            oe: OSErr;
    begin
        oe := ValidateConnection(connection);
        localhost := 0;
        localport := 0;
        remotehost := 0;
        remoteport := 0;
        available := 0;
        if oe <> noErr then begin
            state := 99; { Error -> Closed }
        end
        else begin
            ZeroCB(cb, connection^.stream, TCPcsStatus);
            if PBControlSync(cb) <> noErr then begin
                state := 99; { Closed }
            end
            else begin
                state := cb.status.connectionState;
                localhost := cb.status.localhost;
                localport := cb.status.localport;
                remotehost := cb.status.remotehost;
                remoteport := cb.status.remoteport;
                available := cb.status.amtUnreadData + connection^.incomingSize;
            end;
        end;
    end;

{ Return the state of the TCP connection.}
    function TCPState (connection: TCPConnectionPtr): TCPStateType;
        var
            state: integer;
            localhost: longInt;
            localport: integer;
            remotehost: longInt;
            remoteport: integer;
            available: longInt;
    begin
        TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
        case state of
            0:
                TCPState := T_Closed;
            2:
                TCPState := T_Listening;
            4, 6:
                TCPState := T_Opening;
            8:
                TCPState := T_Established;
            10, 12, 16, 18, 20:
                TCPState := T_Closing;
            14:
                TCPState := T_PleaseClose;
            98:
                TCPState := T_WaitingForOpen;
            99:
                TCPState := T_Closed;
            otherwise
                TCPState := T_Unknown;
        end;
    end;

{    Return the number of characters available for reading from the TCP connection.}
    function TCPCharsAvailable (connection: TCPConnectionPtr): longInt;
        var
            state: integer;
            localhost: longInt;
            localport: integer;
            remotehost: longInt;
            remoteport: integer;
            available: longInt;
    begin
        TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
        TCPCharsAvailable := available;
    end;

    function TCPFlush (connection: TCPConnectionptr): OSErr;
        var
            buffer: array[0..255] of signedByte;
            f: longInt;
            oe: OSErr;
    begin
        f := TCPCharsAvailable(connection);
        oe := noErr;
        while (f > 0) and (oe = noErr) do begin
            if f > 256 then
                f := 256;
            oe := TCPReceiveChars(connection, @buffer, f);
            if oe = noErr then
                f := TCPCharsAvailable(connection);
        end;
        TCPFlush := oe;
    end;

end.